home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue54 / ADOBatch / ADOBatch1U1.pas < prev   
Encoding:
Pascal/Delphi Source File  |  2000-01-02  |  9.4 KB  |  287 lines
  1. unit ADOBatch1U1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   Grids, DBGrids, ExtCtrls, DBCtrls, Db, ADODB, StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ADOTable1: TADOTable;
  12.     DataSource1: TDataSource;
  13.     PageControl1: TPageControl;
  14.     TabSheet1: TTabSheet;
  15.     TabSheet2: TTabSheet;
  16.     Panel1: TPanel;
  17.     DBNavigator1: TDBNavigator;
  18.     Button1: TButton;
  19.     Button2: TButton;
  20.     rgrFilterGroup: TRadioGroup;
  21.     CheckBox1: TCheckBox;
  22.     DBGrid1: TDBGrid;
  23.     rgrSupports: TRadioGroup;
  24.     lblSupports: TLabel;
  25.     Button3: TButton;
  26.     rgrCancelBatch: TRadioGroup;
  27.     StatusBar1: TStatusBar;
  28.     gbxChangeLog: TGroupBox;
  29.     mmoChangeLog: TMemo;
  30.     Button4: TButton;
  31.     ADOConnection1: TADOConnection;
  32.     Button5: TButton;
  33.     cbxUpdateResync: TCheckBox;
  34.     btnDisconnect: TButton;
  35.     procedure Button1Click(Sender: TObject);
  36.     procedure Button2Click(Sender: TObject);
  37.     procedure rgrFilterGroupClick(Sender: TObject);
  38.     procedure CheckBox1Click(Sender: TObject);
  39.     procedure rgrSupportsClick(Sender: TObject);
  40.     procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  41.       DataCol: Integer; Column: TColumn; State: TGridDrawState);
  42.     procedure Button3Click(Sender: TObject);
  43.     procedure ADOTable1RecordChangeComplete(DataSet: TCustomADODataSet;
  44.       const Reason: TEventReason; const RecordCount: Integer;
  45.       const Error: Error; var EventStatus: TEventStatus);
  46.     procedure Button4Click(Sender: TObject);
  47.     procedure Button5Click(Sender: TObject);
  48.     procedure ADOTable1AfterScroll(DataSet: TDataSet);
  49.     procedure FormCreate(Sender: TObject);
  50.     procedure btnDisconnectClick(Sender: TObject);
  51.   private
  52.     { Private declarations }
  53.   public
  54.     { Public declarations }
  55.     procedure ShowData;
  56.     procedure UpdateChangeLog(strChange: string);
  57.     procedure ShowErrors;
  58.     function OriginalValueByName(ADODataSet: TCustomADODataSet;
  59.       strFieldName: string): string;
  60.     function UnderlyingValueByName(ADODataSet: TCustomADODataSet;
  61.       strFieldName: string): string;
  62.   end;
  63.  
  64. var
  65.   Form1: TForm1;
  66.  
  67. implementation
  68.  
  69. {$R *.DFM}
  70.  
  71. procedure TForm1.Button1Click(Sender: TObject);
  72. begin
  73.   ADOTable1.UpdateBatch;
  74. end;
  75.  
  76. procedure TForm1.Button2Click(Sender: TObject);
  77. begin
  78.   case rgrCancelBatch.ItemIndex of
  79.   0: ADOTable1.CancelBatch(arCurrent);
  80.   1: ADOTable1.CancelBatch(arFiltered);
  81.   2: ADOTable1.CancelBatch(arAll);
  82.   3: ADOTable1.CancelBatch(arAllChapters);
  83.   end;
  84. end;
  85.  
  86. procedure TForm1.rgrFilterGroupClick(Sender: TObject);
  87. begin
  88.   case rgrFilterGroup.ItemIndex of
  89.   0:  ADOTable1.FilterGroup:=fgNone;
  90.   1:  ADOTable1.FilterGroup:=fgPendingRecords;
  91.   2:  ADOTable1.FilterGroup:=fgAffectedRecords;
  92.   3:  ADOTable1.FilterGroup:=fgFetchedRecords;
  93.   4:  ADOTable1.FilterGroup:=fgPredicate;
  94.   5:  ADOTable1.FilterGroup:=fgConflictingRecords;
  95.   end;
  96.  
  97.   CheckBox1.Checked:=ADOTable1.Filtered;
  98. end;
  99.  
  100. procedure TForm1.CheckBox1Click(Sender: TObject);
  101. begin
  102.   ADOTable1.Filtered:=CheckBox1.Checked;
  103. end;
  104.  
  105. procedure TForm1.rgrSupportsClick(Sender: TObject);
  106. var
  107.   blnSupports: boolean;
  108. begin
  109.   blnSupports:=False;
  110.   case rgrSupports.ItemIndex of
  111.   0 : blnSupports:=ADOTable1.Supports([coHoldRecords    ]);
  112.   1 : blnSupports:=ADOTable1.Supports([coMovePrevious   ]);
  113.   2 : blnSupports:=ADOTable1.Supports([coAddNew         ]);
  114.   3 : blnSupports:=ADOTable1.Supports([coDelete         ]);
  115.   4 : blnSupports:=ADOTable1.Supports([coUpdate         ]);
  116.   5 : blnSupports:=ADOTable1.Supports([coBookmark       ]);
  117.   6 : blnSupports:=ADOTable1.Supports([coApproxPosition ]);
  118.   7 : blnSupports:=ADOTable1.Supports([coUpdateBatch    ]);
  119.   8 : blnSupports:=ADOTable1.Supports([coResync         ]);
  120.   9 : blnSupports:=ADOTable1.Supports([coNotify         ]);
  121.   10: blnSupports:=ADOTable1.Supports([coFind           ]);
  122.   11: blnSupports:=ADOTable1.Supports([coSeek           ]);
  123.   12: blnSupports:=ADOTable1.Supports([coIndex          ]);
  124.   end;
  125.   if blnSupports then
  126.     lblSupports.Caption:='Supported'
  127.   else
  128.     lblSupports.Caption:='Not Supported';
  129. end;
  130.  
  131. procedure TForm1.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
  132.   DataCol: Integer; Column: TColumn; State: TGridDrawState);
  133. begin
  134.   case ADOTable1.UpdateStatus of
  135.   usModified: DBGrid1.Canvas.Brush.Color:=clBlue;
  136.   usDeleted : DBGrid1.Canvas.Brush.Color:=clRed;
  137.   usInserted: DBGrid1.Canvas.Brush.Color:=clGreen;
  138.   end;
  139.  
  140.   DBGrid1.DefaultDrawDataCell(Rect, Column.Field, State);
  141. end;
  142.  
  143. procedure TForm1.Button3Click(Sender: TObject);
  144. begin
  145.   ADOTable1.CancelUpdates
  146. end;
  147.  
  148. procedure TForm1.ADOTable1RecordChangeComplete(DataSet: TCustomADODataSet;
  149.   const Reason: TEventReason; const RecordCount: Integer;
  150.   const Error: Error; var EventStatus: TEventStatus);
  151. begin
  152.   case Reason of
  153.   erAddNew    : UpdateChangeLog('A new row was added.');
  154.   erDelete    : UpdateChangeLog('An existing row was deleted.');
  155.   erUpdate    : UpdateChangeLog('An existing row was modified with new values.');
  156.   erUndoUpdate    : UpdateChangeLog('An update operation was canceled.');
  157.   erUndoAddNew    : UpdateChangeLog('A row insert operation was canceled.');
  158.   erUndoDelete    : UpdateChangeLog('A row delete operation was canceled.');
  159.   erRequery    : UpdateChangeLog('The recordset was refreshed with the Requery method.');
  160.   erResynch    : UpdateChangeLog('The recordset was resynchronized with the Resynch method.');
  161.   erClose       : UpdateChangeLog('The recordset was closed.');
  162.   erMove        : UpdateChangeLog('The recordsets row pointer moved.');
  163.   erFirstChange    : UpdateChangeLog('Record changed for first time.');
  164.   erMoveFirst    : UpdateChangeLog('The recordsets row pointer moved to the first row.');
  165.   erMoveNext    : UpdateChangeLog('The recordsets row pointer moved to the next row.');
  166.   erMovePrevious: UpdateChangeLog('The recordsets row pointer moved to the previous row.');
  167.   erMoveLast    : UpdateChangeLog('The recordsets row pointer moved to the last row.');
  168.   end;
  169.  
  170.   case EventStatus of
  171.   esOK            : UpdateChangeLog('Operation executed without problem.');
  172.   esErrorsOccured : UpdateChangeLog('An error occurred during execution of the operation.');
  173.   esCantDeny      : UpdateChangeLog('A pending connection operation cannot be canceled. (Connection events only.).');
  174.   esCancel        : UpdateChangeLog('A pending connection has been canceled before it became active. (Connection events only.)');
  175.   esUnwantedEvent : UpdateChangeLog('Set by the ADO method, prevents subsequent notification of the event.');
  176.   end;
  177. end;
  178.  
  179. procedure TForm1.ShowData;
  180. begin
  181.   ShowMessage('An error occurred'+#13+
  182.   'Value: '+ADOTable1.FieldByName('ContactName').AsString+#13+
  183.   'Original: '+OriginalValueByName(ADOTable1, 'ContactName')+#13+
  184.   'Underlying: '+UnderlyingValueByName(ADOTable1, 'ContactName'));
  185. end;
  186.  
  187. procedure TForm1.UpdateChangeLog(strChange: string);
  188. begin
  189.   // StatusBar1.SimpleText:=strChange;
  190.   mmoChangeLog.Lines.Add(strChange);
  191. end;
  192.  
  193. procedure TForm1.Button4Click(Sender: TObject);
  194. begin
  195.   mmoChangeLog.Clear;
  196. end;
  197.  
  198. procedure TForm1.Button5Click(Sender: TObject);
  199. begin
  200.   ADOConnection1.BeginTrans;
  201.   try
  202.     ADOTable1.UpdateBatch;
  203.     ADOConnection1.CommitTrans;
  204.   except
  205.     on E: Exception do
  206.     begin
  207.       ADOConnection1.RollbackTrans;
  208.       // ShowErrors;
  209.       ShowMessage('Errors occurred ('+E.ClassName+')'+#13+'Complete batch rolled back');
  210.     end;
  211.   end;
  212. end;
  213.  
  214. procedure TForm1.ShowErrors;
  215. var
  216.   Err: Error;
  217.   str: string;
  218.   intError: integer;
  219. begin
  220.   str:='';
  221.   for intError:=0 to ADOConnection1.Errors.Count - 1 do
  222.   begin
  223.     Err:=ADOConnection1.Errors.Item[intError];
  224.     str:=str+Err.Description+#13;
  225.   end;
  226.   if str <> '' then
  227.     ShowMessage(str);
  228. end;
  229.  
  230. function TForm1.OriginalValueByName(ADODataSet: TCustomADODataSet; strFieldName: string): string;
  231. var
  232.   Field: TField;
  233. begin
  234.   Field:=ADODataSet.FieldByName(strFieldName);
  235.   Result:=ADODataSet.Recordset.Fields[Field.FieldNo - 1].OriginalValue;
  236. end;
  237.  
  238. function TForm1.UnderlyingValueByName(ADODataSet: TCustomADODataSet; strFieldName: string): string;
  239. var
  240.   Field: TField;
  241. begin
  242.   Field:=ADODataSet.FieldByName(strFieldName);
  243.   Result:=ADODataSet.Recordset.Fields[Field.FieldNo - 1].UnderlyingValue;
  244. end;
  245.  
  246. procedure TForm1.ADOTable1AfterScroll(DataSet: TDataSet);
  247. begin
  248.   ADOTable1.UpdateCursorPos;
  249.  
  250.   StatusBar1.Panels[0].Text:=
  251.   'Value: '+ADOTable1.FieldByName('ContactName').AsString+
  252.   '   NewValue: '+ADOTable1.FieldByName('ContactName').NewValue;
  253.  
  254.   StatusBar1.Panels[1].Text:=
  255.   'Original: '+OriginalValueByName(ADOTable1, 'ContactName')+
  256.   '   OldValue: '+ADOTable1.FieldByName('ContactName').OldValue;
  257.  
  258.   // Jet 4.0 OLE DB Provider does not return the correct value for
  259.   // UnderlyingValue/CurValue
  260.   StatusBar1.Panels[2].Text:=
  261.   'Underlying: '+UnderlyingValueByName(ADOTable1, 'ContactName')+
  262.   '   CurValue: '+ADOTable1.FieldByName('ContactName').CurValue;
  263. end;
  264.  
  265. procedure TForm1.FormCreate(Sender: TObject);
  266. begin
  267.   cbxUpdateResync.Checked:=ADOTable1.Properties['Update Resync'].Value=1;
  268. end;
  269.  
  270. procedure TForm1.btnDisconnectClick(Sender: TObject);
  271. begin
  272.   if ADOTable1.Connection=nil then
  273.   begin
  274.     ADOConnection1.Connected:=True;
  275.     ADOTable1.Connection:=ADOConnection1;
  276.     btnDisconnect.Caption:='Disconnect';
  277.   end
  278.   else
  279.   begin
  280.     ADOTable1.Connection:=nil;
  281.     ADOConnection1.Connected:=False;
  282.     btnDisconnect.Caption:='Connect';
  283.   end
  284. end;
  285.  
  286. end.
  287.